unit uFrmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Grids, StdCtrls, CheckLst, Buttons;

type
  TfrmMain = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    GroupBox1: TGroupBox;
    eAddHeader: TEdit;
    clbHeader: TCheckListBox;
    btnAddHeader: TButton;
    GroupBox4: TGroupBox;
    sgDataSet: TStringGrid;
    BitBtn2: TBitBtn;
    BitBtn1: TBitBtn;
    GroupBox2: TGroupBox;
    mmProses: TMemo;
    btnClearMMProcess: TButton;
    sgTabelUtama: TStringGrid;
    TabSheet3: TTabSheet;
    GroupBox3: TGroupBox;
    mmHasil: TMemo;
    btnLoadDataset: TButton;
    btnSaveDataset: TButton;
    cbSlowMotion: TCheckBox;
    btnProses: TButton;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    sgLHS: TStringGrid;
    cbWordWrap: TCheckBox;
    procedure btnAddHeaderClick(Sender: TObject);
    procedure btnLoadDatasetClick(Sender: TObject);
    procedure btnSaveDatasetClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure btnClearMMProcessClick(Sender: TObject);
    procedure btnProsesClick(Sender: TObject);
    procedure Label1Click(Sender: TObject);
    procedure cbWordWrapClick(Sender: TObject);
  private
    procedure Log(str: string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

uses
  uLib;

var
  bSlowMotion: Boolean;
  FILE_DATASET: string;

procedure TfrmMain.BitBtn1Click(Sender: TObject);
var
  kdRowBefore: Integer;
begin
  sgDataSet.Cells[0, sgDataSet.RowCount] := IntToStr(sgDataSet.RowCount);
  if (sgDataSet.RowCount = 1) or
    (sgDataSet.Cells[1, sgDataSet.RowCount - 1] = '') then
    kdRowBefore := 0
  else
    kdRowBefore := StrToInt(sgDataSet.Cells[1, sgDataSet.RowCount - 1]);

  sgDataSet.RowCount := sgDataSet.RowCount + 1;
  sgDataSet.Cells[1, sgDataSet.RowCount - 1] := IntToStr(kdRowBefore + 1);
end;

procedure TfrmMain.BitBtn2Click(Sender: TObject);
begin
  if sgDataSet.RowCount > 1 then
    sgDataSet.RowCount := sgDataSet.RowCount - 1;
end;

procedure TfrmMain.btnAddHeaderClick(Sender: TObject);
begin
  if clbHeader.Items.Count > 127 then
  begin
    MessageDlg('Jumlah Header tidak boleh lebih dari 127 items', mtError,
      [mbOK], 0);
    Exit;
  end;

  if eAddHeader.Text <> EmptyStr then
  begin
    if clbHeader.Items.IndexOf(eAddHeader.Text) >= 0 then
      MessageDlg('Header ini sudah ada', mtError, [mbOK], 0)
    else
      clbHeader.Items.Add(eAddHeader.Text);
  end
end;

procedure TfrmMain.btnLoadDatasetClick(Sender: TObject);
var
  flDataset: TextFile;
  str: string;
  StrDynArray: TStringDynArray;
  i, j: byte;
  iRowDatasetCount: Integer;
  iColDatasetCount: byte;
  iHeaderAcuan: byte;
begin
  // load dataset
  { load header + load dataset }

  if OpenDialog1.Execute then
    FILE_DATASET := OpenDialog1.FileName
  else
    Exit;

  AssignFile(flDataset, FILE_DATASET);
  try
    Reset(flDataset);
    // read header name

    Readln(flDataset, str);
    //check file
    if Pos('#', str) = 0 then
    begin
      MessageDlg(
        'File tidak valid!'#13#10 +
        'Proses selanjutnya tidak dijalankan', mtError, [mbOK], 0);
      Exit;
    end;

    StrDynArray := Explode('#', str);
    iColDatasetCount := Length(StrDynArray);

    //tambahan kolom untuk nomer dan kode
    sgDataSet.ColCount := iColDatasetCount + 2;

    sgDataSet.Cells[0, 0] := 'No.';
    sgDataSet.ColWidths[0] := 30;
    sgDataSet.Cells[1, 0] := 'Kode';
    sgDataSet.ColWidths[1] := 0;

    sgTabelUtama.Cells[0, 0] := 'No.';
    sgTabelUtama.ColWidths[0] := 30;
    sgTabelUtama.Cells[1, 0] := 'Kode';
    sgTabelUtama.ColWidths[1] := 0;

    sgDataSet.RowCount := 1;
    clbHeader.Clear;

    //nama header -> clbHeader
    for i := 0 to iColDatasetCount - 1 do
    begin
      clbHeader.Items.Add(StrDynArray[i]);
      sgDataSet.Cells[i + 2, 0] := StrDynArray[i];
    end;

    // read letak header acuan
    Readln(flDataset, str);
    //check file
    if not IsInteger(str) then
    begin
      MessageDlg(
        'File tidak valid!'#13#10 +
        'Proses selanjutnya tidak dijalankan', mtError, [mbOK], 0);
      Exit;
    end;

    iHeaderAcuan := StrToInt(str);
    clbHeader.Checked[iHeaderAcuan - 1] := True;

    // read dataset row count
    Readln(flDataset, str);
    //check file
    if not IsInteger(str) then
    begin
      MessageDlg(
        'File tidak valid!'#13#10 +
        'Proses selanjutnya tidak dijalankan', mtError, [mbOK], 0);
      Exit;
    end;

    iRowDatasetCount := StrToInt(str);

    for i := 1 to iRowDatasetCount do
    begin
      sgDataSet.RowCount := sgDataSet.RowCount + 1;
      sgDataSet.Cells[0, i] := IntToStr(i); //nomer
      sgDataSet.Cells[1, i] := IntToStr(i); //kode

      Readln(flDataset, str);
      StrDynArray := Explode('#', str);
      for j := 0 to Length(StrDynArray) - 1 do
        sgDataSet.Cells[j + 2, i] := StrDynArray[j];

      Application.ProcessMessages;
    end;
    sgDataSet.FixedRows := 1;
    Log('Jumlah Kolom:' + IntToStr(iColDatasetCount) + ' ' + 'Jumlah Baris:' +
      IntToStr(iRowDatasetCount));
    AutoSizeAllHeader(sgDataSet);
  finally
    CloseFile(flDataset);
  end;
end;

procedure TfrmMain.Log(str: string);
begin
  mmProses.Lines.Add('[' + TimeToStr(NOW) + ']:' + str);
end;

procedure TfrmMain.btnSaveDatasetClick(Sender: TObject);
begin
  // save dataset
end;

procedure TfrmMain.btnClearMMProcessClick(Sender: TObject);
begin
  mmProses.Lines.Clear;
end;

procedure TfrmMain.btnProsesClick(Sender: TObject);

  function isInstanceAccurate(iHeaderAcuan: Byte; sClass: string): Boolean;
  var
    i: Integer;
  begin
    Result := True;
    for i := 1 to sgTabelUtama.RowCount - 1 do
    begin
      if sgTabelUtama.Cells[iHeaderAcuan, i] <> sClass then
      begin
        Log('Baris:' + IntToStr(i) + ' Nilai:' +
          sgTabelUtama.Cells[iHeaderAcuan, i] +
          ' <> ' + sClass + ' :Tidak Akurat!');
        Result := False;
        Exit;
      end;
    end;
    Log('Akurasi didapatkan!');
  end;

  function GetBiggestLHS: byte;
    function GetTotalInstance(sStr: string): string;
    var
      sSplit: TStringDynArray;
    begin
      sSplit := Explode('/', sStr);
      Result := sSplit[1];
    end;
  var
    i: Byte;
    sSplit: TStringDynArray;
    iBiggestVal: Real;
    iBiggestRowVal: Byte;
  begin
    iBiggestVal := 0;
    iBiggestRowVal := 0;
    for i := 0 to sgLHS.RowCount - 1 do
    begin
      sSplit := Explode('/', sgLHS.Cells[3, i]);
      //Log('GetBiggestLHS:' + sSplit[0] + ' ' + sSplit[1]);

      if iBiggestVal < (StrToInt(sSplit[0]) / StrToInt(sSplit[1])) then
      begin
        Log(
          'Mencari nilai terbesar! ->' +
          sgLHS.Cells[1, iBiggestRowVal] + '=' +
          sgLHS.Cells[2, iBiggestRowVal] + '->' +
          sgLHS.Cells[3, iBiggestRowVal] + ' dengan ' +
          sgLHS.Cells[1, i] + '=' +
          sgLHS.Cells[2, i] + '->' +
          sgLHS.Cells[3, i]);

        Log('Nilai terbesar sementara:' +
          sgLHS.Cells[1, i] + '=' +
          sgLHS.Cells[2, i] + '->' +
          sgLHS.Cells[3, i]);

        iBiggestRowVal := i;
        iBiggestVal := (StrToInt(sSplit[0]) / StrToInt(sSplit[1]));

      end
      else if iBiggestVal = (StrToInt(sSplit[0]) / StrToInt(sSplit[1])) then
      begin
        Log(
          'Nilai yang sama terdeteksi! ->' +
          sgLHS.Cells[1, iBiggestRowVal] + '=' +
          sgLHS.Cells[2, iBiggestRowVal] + '->' +
          sgLHS.Cells[3, iBiggestRowVal] + ' dengan ' +
          sgLHS.Cells[1, i] + '=' +
          sgLHS.Cells[2, i] + '->' +
          sgLHS.Cells[3, i]);

        //cari yang mengcover instance lebih banyak
        if StrToInt(GetTotalInstance(sgLHS.Cells[3, iBiggestRowVal])) <
          StrToInt(GetTotalInstance(sgLHS.Cells[3, i])) then
        begin
          Log('Memakai total instance lebih banyak:' +
            sgLHS.Cells[1, i] + '=' +
            sgLHS.Cells[2, i] + '->' +
            sgLHS.Cells[3, i]);
          iBiggestRowVal := i;
          iBiggestVal := (StrToInt(sSplit[0]) / StrToInt(sSplit[1]));
        end;
      end;
    end;

    Log(
      'Nilai terbesar akhir ->' +
      sgLHS.Cells[1, iBiggestRowVal] + '=' +
      sgLHS.Cells[2, iBiggestRowVal] + '->' +
      sgLHS.Cells[3, iBiggestRowVal]);
    Result := iBiggestRowVal;
  end;

  procedure AddItemsToLHSGrid(HeaderNumber: Byte; HeaderName: string;
    sClass, p_per_t: string);
  begin
    sgLHS.Cells[0, sgLHS.RowCount - 1] := IntToStr(HeaderNumber);
    sgLHS.Cells[1, sgLHS.RowCount - 1] := HeaderName;
    sgLHS.Cells[2, sgLHS.RowCount - 1] := sClass;
    sgLHS.Cells[3, sgLHS.RowCount - 1] := p_per_t;
    sgLHS.RowCount := sgLHS.RowCount + 1;
  end;

  procedure BuildLHS(sLHS: TStringList; HeaderClass: Byte; sClass: string);
  var
    i, j, k: Integer;
    sSplit: TStringDynArray;
    iP: Integer;
    iT: Integer;
    sLst: TStringList;
  begin
    sLst := TStringList.Create;
    //clear sgLHS
    for i := 0 to sgLHS.ColCount - 1 do
      for j := 0 to sgLHS.RowCount - 1 do
        sgLHS.Cells[i, j] := '';
    sgLHS.RowCount := 1;
    //sgLHS.ColWidths[0] := 30;
    try
      //untuk setiap header
      for i := 0 to sLHS.Count - 1 do
      begin
        //clear sLst
        sLst.Clear;
        sSplit := Explode('#', sLHS[i]);
        Log('>>> Kolom:' + sSplit[1]);

        for j := 1 to sgTabelUtama.RowCount - 1 do
        begin
          //masukkan instance
          sLst.Add(sgTabelUtama.Cells[StrToInt(sSplit[0]), j]);
          Application.ProcessMessages;
        end;

        RemoveDuplicates(sLst);

        //cari p/t
        for j := 0 to sLst.Count - 1 do
        begin
          iP := 0;
          iT := 0;

          for k := 1 to sgTabelUtama.RowCount - 1 do
          begin
            //LHS
            //.col number
            //.header name
            //.p
            //.t
            if (sgTabelUtama.Cells[StrToInt(sSplit[0]), k] = sLst[j]) and
            (sgTabelUtama.Cells[HeaderClass, k] = sClass) then
              Inc(iP);

            if (sgTabelUtama.Cells[StrToInt(sSplit[0]), k] = sLst[j]) then
              Inc(iT);
          end;
          Log('>>>> ' + sLst[j] + ':' + IntToStr(iP) + '/' + IntToStr(iT));
          AddItemsToLHSGrid(StrToInt(sSplit[0]), sSplit[1], sLst[j], IntToStr(iP)
            + '/' + IntToStr(iT));
          Application.ProcessMessages;
        end;
      end;
      //delete baris terakhir karena empty
      sgLHS.RowCount := sgLHS.RowCount - 1;
      sgLHS.ColWidths[0] := 0;
      AutoSizeAllHeader(sgLHS, TRUE);
    finally
      sLst.Free;
    end;
  end;

var
  sLstClass: TStringList;
  sLstLHSMain, sLstLHS: TStringList;
  iHeader: Byte; //kita membatasi jumlah header 0 - 127
  i, j, k, l: Integer;
  iHeaderRule: Byte;
  sRule: string;
  bAkurat: Boolean;
  iCurrBiggestLHS: Byte;
  //
  sLstDeletedRow: TStringList; //baris yang terhapus saat re-invent rule
  //iArrayDeletedRow: array of Integer;

  iTotalClassInstance, iCurrTotalClassInstance: Integer;
begin
  if (sgDataSet.RowCount = 1) or (clbHeader.Items.Count = 0) then
  begin
    MessageDlg(
      'Data awal TIDAK valid'#13#10 +
      'Proses selanjutnya tidak dilakukan', mtError, [mbOK], 0);
    Exit;
  end;

  //class yang akan dicari

  bSlowMotion := cbSlowMotion.Checked;

  sLstClass := TStringList.Create;
  //LHS
  sLstLHS := TStringList.Create;
  sLstLHSMain := TStringList.Create;
  sLstDeletedRow := TStringList.Create;
  iHeaderRule := 0;

  try
    for iHeader := 0 to clbHeader.Count - 1 do
    begin
      if clbHeader.Checked[iHeader] = True then
      begin
        for i := 1 to sgDataSet.RowCount - 1 do
          sLstClass.Add(sgDataSet.Cells[iHeader + 2, i]);
        iHeaderRule := iHeader + 2; //simpan header acuan
        //Break;
      end
      else
        //masukkan LHS ke list format:no.header#nama_header
        sLstLHSMain.Add(IntToStr(iHeader + 2) + '#' +
          clbHeader.Items.Strings[iHeader]);
    end;

    //remove duplikat dari class yang dicari
    RemoveDuplicates(sLstClass);

    mmHasil.Lines.Clear;
    {!!!!!!!!!!!! MAIN PROCESS !!!!!!!!!!!!!!!!!!!!}

    for i := 0 to sLstClass.Count - 1 do
    begin
      //mencari jumlah total class instance
      iTotalClassInstance := 0;
      iCurrTotalClassInstance := 0;

      for j := 0 to sgDataSet.RowCount - 1 do
      begin
        if sgDataSet.Cells[iHeaderRule, j + 1] = sLstClass[i] then
          inc(iTotalClassInstance);
      end;
      Log('Mencari Rule dari:' + sLstClass[i] + ' (Total Instance:' +
        IntToStr(iTotalClassInstance) + ')');

      sLstDeletedRow.Clear;

      //loop 1 here
      while iTotalClassInstance <> iCurrTotalClassInstance do
      begin
        sLstLHS.Assign(sLstLHSMain);

        if bSlowMotion then
          Sleep(1000);

        //Log('Total instance class:');

        Log('Membuat tabel utama:MULAI!');

        sgTabelUtama.RowCount := sgDataSet.RowCount;
        sgTabelUtama.ColCount := sgDataSet.ColCount;

        for j := 0 to sgDataSet.ColCount - 1 do
          for k := 0 to sgDataSet.RowCount - 1 do
          begin
            sgTabelUtama.Cells[j, k] := sgDataSet.Cells[j, k];
          end;
        Log('Membuat tabel utama:SELESAI!');
        AutoSizeAllHeader(sgTabelUtama);
        sgTabelUtama.Repaint;

        //delete baris yang ada di sLstDeletedRow
        if sLstDeletedRow.Count > 0 then
        begin
          for j := 0 to sLstDeletedRow.Count - 1 do
          begin
            Log('Hapus No:' + sLstDeletedRow[j]);
            for k := 1 to sgTabelUtama.RowCount - 1 do
            begin
              if sgTabelUtama.Cells[0, k] = sLstDeletedRow[j] then
                DeleteRow(sgTabelUtama, k);
            end;
          end;
          //Exit;
        end;

        if bSlowMotion then
          Sleep(1000);

        sRule := 'IF';
        bAkurat := False;

        //loop 2 here !
        while not bAkurat do
        begin
          Log('Membuat Kondisi LHS:Mulai');
          BuildLHS(sLstLHS, iHeaderRule, sLstClass[i]);
          sgLHS.Repaint;
          Log('Membuat Kondisi LHS:SELESAI');

          if bSlowMotion then
            Sleep(1000);

          iCurrBiggestLHS := GetBiggestLHS;
          //Log('function GetBiggestRow():' + IntToStr(iCurrBiggestLHS));

          if bSlowMotion then
            Sleep(1000);

          sgLHS.Repaint;

          sRule := sRule + ' ' + sgLHS.Cells[1, iCurrBiggestLHS] + ' = ' +
            sgLHS.Cells[2, iCurrBiggestLHS] + ' AND';
          Log('Rule sementara:' + copy(sRule, 1, Length(sRule) - 4) + ' THEN ' +
            sgTabelUtama.Cells[iHeaderRule, 0] + ' = ' + sLstClass[i]);
          if bSlowMotion then
            Sleep(1000);

          //cari kode sgtabelutama dengan rule terbaru
          l := 0;
          while l <> sgTabelUtama.RowCount - 1 do
          begin
            //filter berdasarkan rule terakhir
            inc(l);
            if (sgTabelUtama.Cells[StrToInt(sgLHS.Cells[0, iCurrBiggestLHS]), l]
              <> sgLHS.Cells[2, iCurrBiggestLHS]) then
            begin
              Log('Hapus No:' + sgTabelUtama.Cells[0, l]);
              DeleteRow(sgTabelUtama, l);
              Application.ProcessMessages;

              if bSlowMotion then
                Sleep(1000);

              sgTabelUtama.Repaint;

              l := 0;
            end;
            Application.ProcessMessages;
            //Exit;
          end;

          //Exit;
          //membuang header LHS yang sudah dipake

          Log('Delete LHS Header:' + sgLHS.Cells[1, iCurrBiggestLHS]);
          sLstLHS.Delete(sLstLHS.IndexOf(sgLHS.Cells[0, iCurrBiggestLHS] + '#' +
            sgLHS.Cells[1, iCurrBiggestLHS]));
          //cek apakah sudah akurat ?
          bAkurat := isInstanceAccurate(iHeaderRule, sLstClass[i]);
          Application.ProcessMessages;
        end;
        Log('Didapat rule:' + copy(sRule, 1, Length(sRule) - 4) + ' THEN ' +
          sgTabelUtama.Cells[iHeaderRule, 0] + ' = ' + sLstClass[i]);

        if bSlowMotion then
          Sleep(1000);

        mmHasil.Lines.Add('* ' + copy(sRule, 1, Length(sRule) - 4) + ' THEN ' +
          sgTabelUtama.Cells[iHeaderRule, 0] + ' = ' + sLstClass[i]);

        iCurrTotalClassInstance := iCurrTotalClassInstance +
          sgTabelUtama.RowCount - 1;

        if iCurrTotalClassInstance <> iTotalClassInstance then
        begin
          Log('Mencari Rule lainnya untuk kasus:' + sLstClass[i]);

          for j := 0 to sgTabelUtama.RowCount - 2 do
          begin
            sLstDeletedRow.Add(sgTabelUtama.Cells[0, j + 1]);
            Log('Menambahkan No.:' + sgTabelUtama.Cells[0, j + 1] +
              ' ke sLstDeletedRow');
          end;
        end
        else
          Log('Seluruh kasus:' + sLstClass[i] + ' telah tercover');
        //Exit;
      end;

      Log('******************************************************');

    end;
    MessageDlg('Selesai', mtInformation, [mbOK], 0);
  finally
    sLstClass.Free;
    sLstLHS.Free;
    sLstLHSMain.Free;
    sLstDeletedRow.Free;
  end;
end;

procedure TfrmMain.Label1Click(Sender: TObject);
const
  sAbout =
    'Cendrowska,J.(1987) PRISM:an Algorithm for Inducing Modular Rules'#13#10 +
    'International Journal of Man-Machine Studies,Vol.27, No.4, pp.349-370';
begin
  MessageDlg(sAbout, mtInformation, [mbOK], 0);
end;

procedure TfrmMain.cbWordWrapClick(Sender: TObject);
begin
  mmProses.WordWrap := cbWordWrap.Checked;
end;

end.

